perm filename WEAVE.PAS[WEB,ALS] blob
sn#671670 filedate 1982-08-04 generic text, type C, neo UTF8
COMMENT ā VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {2}{4}{$C-,A+,D-}{[$C+,D+]}
C00015 00003 {42}PROCEDURE Printid(p:namepointer)
C00027 00004 {71}PROCEDURE Getline
C00042 00005 {100}PROCEDURE Pascalxref
C00058 00006 {161}PROCEDURE Red(j:sixteenbits
C00093 00007 {173}{185}PROCEDURE Appcomment
C00107 00008 {182}PROCEDURE Subcases(p:namepointer)
C00125 00009 {187}PROCEDURE Outerparse
C00150 00010 {244}{PROCEDURE DEBUGHELP
C00183 ENDMK
Cā;
{2}{4}{$C-,A+,D-}{[$C+,D+]}
PROGRAM Weave(webfile,changefile,texfile);
LABEL
9999;
CONST
{8}maxbytes=40000;
maxnames=5000;
hashsize=353;
bufsize=100;
longestname=400;
longbufsize=500;
linelength=80;
maxrefs=20000;
maxtoks=20000;
maxtexts=2000;
maxscraps=1000;
stacksize=200;
TYPE
{9}asciicode=0..127;
{10}textfile=PACKED FILE OF char;
{34}eightbits=0..255;
sixteenbits=0..65535;
{36}namepointer=0..maxnames;
{47}textpointer=0..maxtexts;
{190}mode=(inner,outer);
outputstate=RECORD endfield:sixteenbits;
tokfield:sixteenbits;
modefield:mode;
END;
VAR
{11}xord:ARRAY[char]OF asciicode;
xchr:ARRAY[asciicode]OF char;
{18}termout:textfile;
{21}webfile:textfile;
changefile:textfile;
{23}texfile:textfile;
{25}buffer:ARRAY[0..longbufsize]OF asciicode;
{27}phaseone:boolean;
{35}bytemem:PACKED ARRAY[0..1,0..maxbytes]OF asciicode;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames]OF sixteenbits;
xref:ARRAY[0..maxnames]OF sixteenbits;
{37}nameptr:namepointer;
byteptr:ARRAY[0..1]OF 0..maxbytes;
{43}xmem:ARRAY[0..maxrefs]OF PACKED RECORD numfield:sixteenbits;
xlinkfield:sixteenbits;
END;
xrefptr:0..maxrefs;
modulecount:0..10239;
xrefswitch,modxrefswitc:0..10240;
{48}tokmem:PACKED ARRAY[0..maxtoks]OF sixteenbits;
tokstart:ARRAY[textpointer]OF sixteenbits;
textptr:textpointer;
tokptr:0..maxtoks;
{MAXTOKPTR,MAXTXTPTR:0..MAXTOKS;
}{50}idfirst:0..longbufsize;
idloc:0..longbufsize;
hash:ARRAY[0..hashsize]OF sixteenbits;
{58}curname:namepointer;
{60}modtext:ARRAY[0..longestname]OF asciicode;
{66}line:integer;
otherline:integer;
templine:integer;
limit:0..longbufsize;
loc:0..longbufsize;
inputhasende:boolean;
changing:boolean;
{67}changebuffer:ARRAY[0..bufsize]OF asciicode;
changelimit:0..bufsize;
{85}curmodule:namepointer;
{97}nextcontrol:eightbits;
{103}lhs,rhs:namepointer;
{107}curxref:0..maxrefs;
{110}outbuf:ARRAY[0..linelength]OF asciicode;
outptr:0..linelength;
outline:integer;
{118}dig:ARRAY[0..4]OF 0..9;
{133}cat:ARRAY[0..maxscraps]OF eightbits;
trans:ARRAY[0..maxscraps]OF textpointer;
pp:0..maxscraps;
scrapbase:0..maxscraps;
scrapptr:0..maxscraps;
loptr:0..maxscraps;
hiptr:0..maxscraps;
{MAXSCRPTR:0..MAXSCRAPS;}{166}{TRACING:0..2;
}{191}curstate:outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
{MAXSTACKPTR:0..STACKSIZE;}{208}saveline:integer;
saveplace:sixteenbits;
{216}thismodule:namepointer;
{225}bucket:ARRAY[asciicode]OF namepointer;
nextname:namepointer;
c:asciicode;
h:0..hashsize;
blink:ARRAY[0..maxnames]OF sixteenbits;
{227}curdepth:eightbits;
curbyte:0..maxbytes;
curbank:0..1;
curval:sixteenbits;
{MAXSORTPTR:0..MAXSCRAPS;
}{229}collate:ARRAY[0..100]OF asciicode;
{238}nextxref,thisxref:0..maxrefs;
{242}{TROUBLESHOOT:BOOLEAN;
DDT:SIXTEENBITS;
DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;
DEBUGSKIPPED:INTEGER;
TERMIN:TEXTFILE;}
{28}{PROCEDURE DEBUGHELP;
FORWARD;}{29}
PROCEDURE Error;
VAR
k,l:0..longbufsize;
BEGIN{30}
BEGIN
IF changing THEN
Write(termout,'. (change file ')
ELSE
Write(termout,'. (');
Writeln(termout,'l.',line:0,')');
IF loc>=limit THEN
l:=limit
ELSE
l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN
Write(termout,' ')
ELSE
Write(
termout,xchr[buffer[k-1]]);
Writeln(termout);
FOR k:=1 TO l DO Write(termout,' ');
FOR k:=l+1 TO limit DO Write(termout,xchr[buffer[k-1]]);
IF buffer[limit]=124 THEN
Write(termout,xchr[124]);
Write(termout,' ');
END;
Break(termout);
{DEBUGSKIPPED:=DEBUGCYCLE;
DEBUGHELP;}
END;
{31}
PROCEDURE Quit;
BEGIN
GOTO 9999;
END;
PROCEDURE Initialize;
VAR
{14}i:0..127;
{38}wi:0..1;
{51}h:0..hashsize;
{230}c:asciicode;
BEGIN{12}
xchr[32]:=' ';
xchr[33]:='!';
xchr[34]:='"';
xchr[35]:='#';
xchr[36]:='$';
xchr[37]:='%';
xchr[38]:='&';
xchr[39]:='''';
xchr[40]:='(';
xchr[41]:=')';
xchr[42]:='*';
xchr[43]:='+';
xchr[44]:=',';
xchr[45]:='-';
xchr[46]:='.';
xchr[47]:='/';
xchr[48]:='0';
xchr[49]:='1';
xchr[50]:='2';
xchr[51]:='3';
xchr[52]:='4';
xchr[53]:='5';
xchr[54]:='6';
xchr[55]:='7';
xchr[56]:='8';
xchr[57]:='9';
xchr[58]:=':';
xchr[59]:=';';
xchr[60]:='<';
xchr[61]:='=';
xchr[62]:='>';
xchr[63]:='?';
xchr[64]:='@';
xchr[65]:='A';
xchr[66]:='B';
xchr[67]:='C';
xchr[68]:='D';
xchr[69]:='E';
xchr[70]:='F';
xchr[71]:='G';
xchr[72]:='H';
xchr[73]:='I';
xchr[74]:='J';
xchr[75]:='K';
xchr[76]:='L';
xchr[77]:='M';
xchr[78]:='N';
xchr[79]:='O';
xchr[80]:='P';
xchr[81]:='Q';
xchr[82]:='R';
xchr[83]:='S';
xchr[84]:='T';
xchr[85]:='U';
xchr[86]:='V';
xchr[87]:='W';
xchr[88]:='X';
xchr[89]:='Y';
xchr[90]:='Z';
xchr[91]:='[';
xchr[92]:='\';
xchr[93]:=']';
xchr[94]:='ā';
xchr[95]:='_';
xchr[96]:='`';
xchr[97]:='a';
xchr[98]:='b';
xchr[99]:='c';
xchr[100]:='d';
xchr[101]:='e';
xchr[102]:='f';
xchr[103]:='g';
xchr[104]:='h';
xchr[105]:='i';
xchr[106]:='j';
xchr[107]:='k';
xchr[108]:='l';
xchr[109]:='m';
xchr[110]:='n';
xchr[111]:='o';
xchr[112]:='p';
xchr[113]:='q';
xchr[114]:='r';
xchr[115]:='s';
xchr[116]:='t';
xchr[117]:='u';
xchr[118]:='v';
xchr[119]:='w';
xchr[120]:='x';
xchr[121]:='y';
xchr[122]:='z';
xchr[123]:='{';
xchr[124]:='|';
xchr[125]:='}';
xchr[126]:='~';
xchr[0]:=' ';
xchr[127]:=' ';
{15}
FOR i:=1 TO 31 DO xchr[i]:=' ';
{16}
FOR i:=0 TO 127 DO xord[Chr(i)]:=32;
FOR i:=1 TO 126 DO xord[xchr[i]]:=i;
{19}Rewrite(termout,'TTY:');
{24}Rewrite(texfile);
{39}
FOR wi:=0 TO 1 DO
BEGIN
bytestart[wi]:=0;
byteptr[wi]:=0;
END;
bytestart[2]:=0;
nameptr:=1;
{41}ilk[0]:=0;
{44}xrefptr:=0;
xrefswitch:=0;
modxrefswitc:=0;
xmem[0].numfield:=0;
{49}tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
{MAXTOKPTR:=1;
MAXTXTPTR:=1;}{52}
FOR h:=0 TO hashsize-1 DO hash[h]:=0;
{92}modtext[0]:=32;
{113}outptr:=1;
outline:=1;
outbuf[1]:=114;
Write(texfile,'\input webhd');
{115}outbuf[0]:=92;
{134}scrapbase:=1;
scrapptr:=0;
{MAXSCRPTR:=0;}{192}{MAXSTACKPTR:=0;}{228}{MAXSORTPTR:=0;
}{231}collate[0]:=0;
collate[1]:=32;
FOR c:=1 TO 31 DO collate[c+1]:=c;
FOR c:=33 TO 47 DO collate[c]:=c;
FOR c:=58 TO 64 DO collate[c-10]:=c;
FOR c:=91 TO 94 DO collate[c-36]:=c;
collate[59]:=96;
FOR c:=123 TO 126 DO collate[c-63]:=c;
collate[64]:=95;
FOR c:=97 TO 122 DO collate[c-32]:=c;
FOR c:=48 TO 57 DO collate[c+43]:=c;
{243}{TROUBLESHOOT:=TRUE;
DEBUGCYCLE:=1;
DEBUGSKIPPED:=0;
TRACING:=0;
TROUBLESHOOT:=FALSE;
DEBUGCYCLE:=99999;
RESET(TERMIN,'TTY:','/I');}
END;
{22}
PROCEDURE Openinput;
BEGIN
Reset(webfile);
Reset(changefile);
END;
{26}
FUNCTION Inputln(VAR f:textfile):boolean;
BEGIN
limit:=0;
IF Eof(f)THEN
Inputln:=false
ELSE
BEGIN
WHILE NOT Eoln(f)DO
BEGIN
buffer
[limit]:=xord[fā];
Get(f);
limit:=limit+1;
IF limit=bufsize THEN
BEGIN
WHILE NOT Eoln(f)DO Get(f);
limit:=limit-1;
BEGIN
Writeln(termout);
Write(termout,'! Input line too long');
END;
Error;
END;
END;
Readln(f);
Inputln:=true;
END;
END;
{42}PROCEDURE Printid(p:namepointer);
VAR
k:0..maxbytes;
w:0..1;
BEGIN
IF p>=nameptr THEN
Write(termout,'IMPOSSIBLE')
ELSE
BEGIN
w:=p MOD
2;
FOR k:=bytestart[p]TO bytestart[p+2]-1 DO Write(termout,xchr[bytemem[w,k
]]);
END;
END;
{45}
PROCEDURE Newxref(p:namepointer);
LABEL
10;
VAR
q:0..maxrefs;
m,n:sixteenbits;
BEGIN
IF((ilk[p]>3)OR(bytestart[p]+1=bytestart[p+2]))AND(xrefswitch=0)
THEN
GOTO 10;
m:=modulecount+xrefswitch;
xrefswitch:=0;
q:=xref[p];
IF q>0 THEN
BEGIN
n:=xmem[q].numfield;
IF(n=m)OR(n=m+10240)THEN
GOTO 10
ELSE
IF m=n+10240 THEN
BEGIN
xmem[q].
numfield:=m;
GOTO 10;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','cross reference',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=m;
END;
xmem[xrefptr].xlinkfield:=q;
xref[p]:=xrefptr;
10:
END;
{46}
PROCEDURE Newmodxref(p:namepointer);
VAR
q,r:0..maxrefs;
BEGIN
q:=xref[p];
r:=0;
IF q>0 THEN
BEGIN
IF modxrefswitc=0 THEN
WHILE xmem[q].numfield>=10240
DO
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END
ELSE
IF xmem[q].numfield>=10240 THEN
BEGIN
r:=q;
q:=xmem[q].xlinkfield;
END;
END;
IF xrefptr=maxrefs THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','cross reference',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
xrefptr:=xrefptr+1;
xmem[xrefptr].numfield:=modulecount+modxrefswitc;
END;
xmem[xrefptr].xlinkfield:=q;
modxrefswitc:=0;
IF r=0 THEN
xref[p]:=xrefptr
ELSE
xmem[r].xlinkfield:=xrefptr;
END;
{53}
FUNCTION Idlookup(t:eightbits):namepointer;
LABEL
31;
VAR
i:0..longbufsize;
h:0..hashsize;
k:0..maxbytes;
w:0..1;
l:0..longbufsize;
p,q:namepointer;
BEGIN
l:=idloc-idfirst;
{54}h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
{55}p:=hash[h];
WHILE p<>0 DO
BEGIN
IF(bytestart[p+2]-bytestart[p]=l)AND((ilk[p]=t)OR((t
=0)AND(ilk[p]>3)))THEN
{56}
BEGIN
i:=idfirst;
k:=bytestart[p];
w:=p MOD 2;
WHILE(i<idloc)AND(buffer[i]=bytemem[w,k])DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN
GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF p=nameptr THEN
{57}
BEGIN
w:=nameptr MOD 2;
IF byteptr[w]+l>maxbytes THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr+2>maxnames THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
i:=idfirst;
k:=byteptr[w];
WHILE i<idloc DO
BEGIN
bytemem[w,k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr[w]:=k;
bytestart[nameptr+2]:=k;
nameptr:=nameptr+1;
ilk[p]:=t;
xref[p]:=0;
END;
Idlookup:=p;
END;
{61}
FUNCTION Modlookup(l:sixteenbits):namepointer;
LABEL
31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
w:0..1;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN{63}
BEGIN
k:=bytestart[p];
w:=p MOD 2;
c:=equal;
j:=1;
WHILE(k<bytestart[p+2])AND(j<=l)AND(modtext[j]=bytemem[w,k])DO
BEGIN
k:=
k+1;
j:=j+1;
END;
IF k=bytestart[p+2]THEN
IF j>l THEN
c:=equal
ELSE
c:=extension
ELSE
IF j
>l THEN
c:=prefix
ELSE
IF modtext[j]<bytemem[w,k]THEN
c:=less
ELSE
c:=
greater;
END;
q:=p;
IF c=less THEN
p:=link[q]
ELSE
IF c=greater THEN
p:=ilk[q]
ELSE
GOTO 31;
END;
{62}w:=nameptr MOD 2;
k:=byteptr[w];
IF k+l>maxbytes THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr>maxnames-2 THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
p:=nameptr;
IF c=less THEN
link[q]:=p
ELSE
ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
xref[p]:=0;
c:=equal;
FOR j:=1 TO l DO bytemem[w,k+j-1]:=modtext[j];
byteptr[w]:=k+l;
bytestart[nameptr+2]:=k+l;
nameptr:=nameptr+1;;
31:
IF c<>equal THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Incompatible module names');
Error;
END;
END;
p:=0;
END;
Modlookup:=p;
END;
{64}
FUNCTION Prefixlookup(l:sixteenbits):namepointer;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
w:0..1;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN{63}
BEGIN
k:=bytestart[p];
w:=p MOD 2;
c:=equal;
j:=1;
WHILE(k<bytestart[p+2])AND(j<=l)AND(modtext[j]=bytemem[w,k])DO
BEGIN
k:=
k+1;
j:=j+1;
END;
IF k=bytestart[p+2]THEN
IF j>l THEN
c:=equal
ELSE
c:=extension
ELSE
IF j
>l THEN
c:=prefix
ELSE
IF modtext[j]<bytemem[w,k]THEN
c:=less
ELSE
c:=
greater;
END;
IF c=less THEN
p:=link[p]
ELSE
IF c=greater THEN
p:=ilk[p]
ELSE
BEGIN
r:=p
;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Name does not match');
Error;
END;
END
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Ambiguous prefix');
Error;
END;
END;
Prefixlookup:=r;
END;
{68}
PROCEDURE Primethechan;
LABEL
20;
VAR
k:0..bufsize;
nonblank:boolean;
BEGIN
20:
IF Inputln(changefile)THEN
BEGIN
IF buffer[0]=37 THEN
GOTO 20;
buffer[limit]:=32;
nonblank:=false;
FOR k:=0 TO limit DO
BEGIN
changebuffer[k]:=buffer[k];
IF buffer[k]<>32 THEN
nonblank:=true;
END;
IF NOT nonblank THEN
GOTO 20;
changelimit:=limit;
END
ELSE
BEGIN
changebuffer[0]:=0;
changelimit:=0;
END;
END;
{69}
PROCEDURE Checkchange;
LABEL
10;
VAR
k:0..bufsize;
BEGIN
FOR k:=1 TO limit-1 DO
IF buffer[k]<>changebuffer[k]THEN
GOTO 10;
changing:=true;
templine:=otherline;
otherline:=line;
line:=templine;
10:
END;
{70}
PROCEDURE Resetinput;
BEGIN
Openinput;
line:=1;
changing:=false;
Primethechan;
otherline:=line;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
END;
{71}PROCEDURE Getline;
LABEL
10,30,31;
BEGIN
line:=line+1;
IF changing THEN
{73}
BEGIN
IF limit>1 THEN
IF(buffer[0]=64)AND((buffer[1]
=122)OR(buffer[1]=90))THEN
{74}
BEGIN
changing:=false;
Primethechan;
templine:=otherline;
otherline:=line;
line:=templine;
{75}
WHILE true DO
BEGIN
loc:=0;
line:=line+1;
IF Inputln(webfile)THEN
{76}
BEGIN
buffer[limit+1]:=64;
WHILE true DO
BEGIN
IF buffer[loc]=64 THEN
IF loc<limit THEN
BEGIN
loc:=
loc+2;
IF(buffer[loc-1]=32)OR(buffer[loc-1]=9)OR(buffer[loc-1]=42)THEN
BEGIN
loc:=loc-2;
GOTO 31;
END
ELSE
IF(buffer[loc-1]=122)OR(buffer[loc-1]=90)THEN
GOTO 31;
END
ELSE
GOTO 30
ELSE
loc:=loc+1;
END;
30:
END
ELSE
BEGIN
inputhasende:=true;
GOTO 31;
END;
END;
31:;
buffer[limit]:=32;
IF(buffer[0]=changebuffer[0])AND(limit=changelimit)THEN
Checkchange;
GOTO 10;
END;
IF NOT Inputln(changefile)THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Change file ended without @z');
Error;
END;
END;
buffer[0]:=64;
buffer[1]:=122;
limit:=2;
END;
END
ELSE
{72}
BEGIN
IF NOT Inputln(webfile)THEN
inputhasende:=true
ELSE
IF
(buffer[0]=changebuffer[0])AND(limit=changelimit)THEN
Checkchange;
END;
loc:=0;
buffer[limit]:=32;
10:
END;
{79}
FUNCTION Controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:Controlcode:=64;
39:Controlcode:=12;
36:Controlcode:=135;
32,9,42:Controlcode:=147;
68,100:Controlcode:=143;
70,102:Controlcode:=142;
123:Controlcode:=9;
125:Controlcode:=10;
80,112:Controlcode:=144;
38:Controlcode:=127;
60:Controlcode:=145;
62:BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Extra @>');
Error;
END;
END;
Controlcode:=0;
END;
84,116:Controlcode:=134;
90,122:Controlcode:=146;
33:Controlcode:=126;
63:Controlcode:=125;
94:Controlcode:=131;
58:Controlcode:=132;
46:Controlcode:=133;
44:Controlcode:=136;
124:Controlcode:=137;
47:Controlcode:=138;
35:Controlcode:=139;
43:Controlcode:=140;
59:Controlcode:=141;
{80}{48,49,50:BEGIN TRACING:=C-48;
CONTROLCODE:=0;
END;}OTHERS:BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Unknown control code');
Error;
END;
END;
Controlcode:=0;
END
END;
END;
{81}
PROCEDURE Skiplimbo;
LABEL
10;
VAR
c:asciicode;
BEGIN
WHILE true DO
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
GOTO 10;
END
ELSE
BEGIN
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN
GOTO 10;
END;
END;
10:
END;
{82}
FUNCTION Skiptex:eightbits;
LABEL
30;
VAR
c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
BEGIN
c:=146;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
REPEAT
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
GOTO 30;
END;
END;
30:
Skiptex:=c;
END;
{83}
FUNCTION Skipcomment(bal:eightbits):eightbits;
LABEL
30;
VAR
c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
BEGIN
bal:=0;
GOTO 30;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
{84}
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9)AND(c<>42)THEN
loc:=loc+1
ELSE
BEGIN
loc:=loc-1;
bal:=0;
GOTO 30;
END
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN
loc:=loc+1
ELSE
IF c=123
THEN
bal:=bal+1
ELSE
IF c=125 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN
GOTO 30;
END;
END;
30:
Skipcomment:=bal;
END;
{86}
FUNCTION Getnext:eightbits;
LABEL
20,30,31;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
BEGIN
c:=146;
GOTO 31;
END;
END;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{88}BEGIN
IF((c=69)OR(c=101
))AND(loc>1)THEN
IF(buffer[loc-2]<=57)AND(buffer[loc-2]>=48)THEN
c:=128;
IF c<>128 THEN
BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT
loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))OR((d>90)AND(d<97))OR(d>122))AND(d<>95);
c:=130;
idloc:=loc;
END;
END;
39,34:{89}BEGIN
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout
);
Write(termout,'! String constant didn''t end');
Error;
END;
END;
loc:=limit;
d:=c;
END;
UNTIL d=c;
idloc:=loc;
c:=129;
END;
64:{90}BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=126 THEN
BEGIN
xrefswitch:=10240;
GOTO 20;
END
ELSE
IF c=125 THEN
BEGIN
xrefswitch:=0;
GOTO 20;
END
ELSE
IF(c<=134)AND(c>=131)THEN
{96}
BEGIN
idfirst:=loc;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
idloc:=loc;
IF loc>limit THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout
);
Write(termout,'! Control text didn''t end');
Error;
END;
END;
loc:=limit;
END
ELSE
BEGIN
loc:=loc+2;
IF buffer[loc-1]<>62 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Control codes are forbidden in control text');
Error;
END;
END;
END;
END
ELSE
IF c=145 THEN
{91}
BEGIN{93}
k:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Input ended in module name');
Error;
END;
END;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
{94}
IF d=64 THEN
BEGIN
d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42)THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Module name didn''t end');
Error;
END;
END;
GOTO 30;
END;
k:=k+1;
modtext[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<longestname-1 THEN
k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF modtext[k-1]=32 THEN
k:=k-1;
END;
modtext[k]:=d;
END;
30:{95}
IF k>=longestname-2 THEN
BEGIN
BEGIN
Writeln(termout);
Write(termout,'! Module name too long: ');
END;
FOR j:=1 TO 25 DO Write(termout,xchr[modtext[j]]);
Write(termout,'...');
END;
IF(modtext[k]=32)AND(k>0)THEN
k:=k-1;
IF k>3 THEN
BEGIN
IF(modtext[k]=46)AND(modtext[k-1]=46)AND(modtext[k-2]=
46)THEN
curmodule:=Prefixlookup(k-3)
ELSE
curmodule:=Modlookup(k);
END
ELSE
curmodule:=Modlookup(k);
END;
END;
{87}46:IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END
ELSE
IF buffer[loc]=41 THEN
BEGIN
c:=93;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=24;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=loc+1;
END;
60:IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE
IF buffer[loc]=62 THEN
BEGIN
c:=26;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;
loc:=loc+1;
END
ELSE
IF buffer[loc]=46 THEN
BEGIN
c:=91;
loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
OTHERS:
END;
31:{IF TROUBLESHOOT THEN DEBUGHELP;}
Getnext:=c;
END;
{100}PROCEDURE Pascalxref;
LABEL
10;
VAR
p:namepointer;
BEGIN
WHILE nextcontrol<142 DO
BEGIN
IF(nextcontrol>=130)AND(nextcontrol
<=133)THEN
BEGIN
p:=Idlookup(nextcontrol-130);
Newxref(p);
IF(ilk[p]=17)OR(ilk[p]=22)THEN
xrefswitch:=10240;
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN
GOTO 10;
END;
10:
END;
{101}
PROCEDURE Outerxref;
VAR
bal:eightbits;
BEGIN
WHILE nextcontrol<142 DO
IF nextcontrol<>123 THEN
Pascalxref
ELSE
BEGIN
bal:=Skipcomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
Pascalxref;
IF nextcontrol=124 THEN
bal:=Skipcomment(bal)
ELSE
bal:=0;
END;
END;
END;
{108}
PROCEDURE Modcheck(p:namepointer);
BEGIN
IF p>0 THEN
BEGIN
Modcheck(link[p]);
curxref:=xref[p];
IF xmem[curxref].numfield<10240 THEN
BEGIN
BEGIN
Writeln(termout);
Write(termout,'! Never defined: <');
END;
Printid(p);
Write(termout,'>');
END;
WHILE xmem[curxref].numfield>=10240 DO curxref:=xmem[curxref].xlinkfield
;
IF curxref=0 THEN
BEGIN
BEGIN
Writeln(termout);
Write(termout,'! Never used: <');
END;
Printid(p);
Write(termout,'>');
END;
Modcheck(ilk[p]);
END;
END;
{111}
PROCEDURE Flushbuffer(b:eightbits);
VAR
k:0..linelength;
BEGIN
IF(outbuf[b]=32)AND(b>0)THEN
b:=b-1;
FOR k:=1 TO b DO Write(texfile,xchr[outbuf[k]]);
Writeln(texfile);
outline:=outline+1;
IF b<outptr THEN
IF outbuf[b+1]=32 THEN
b:=b+1;
IF b<outptr THEN
FOR k:=b+1 TO outptr DO outbuf[k-b]:=outbuf[k];
outptr:=outptr-b;
END;
{112}
PROCEDURE Finishline;
LABEL
10;
VAR
k:0..bufsize;
BEGIN
IF outptr>0 THEN
Flushbuffer(outptr)
ELSE
BEGIN
FOR k:=0 TO limit
DO
IF(buffer[k]<>32)AND(buffer[k]<>9)THEN
GOTO 10;
Flushbuffer(0);
END;
10:
END;
{116}
PROCEDURE Breakout;
VAR
k:0..linelength;
c,d:asciicode;
BEGIN
k:=outptr;
d:=outbuf[k];
WHILE d<>32 DO
BEGIN
k:=k-1;
c:=outbuf[k];
IF c=92 THEN
IF k=0 THEN
{117}
BEGIN
BEGIN
Writeln(termout);
Write(termout,'! Line had to be broken (output l.',outline:0);
END;
Writeln(termout,'):');
FOR k:=1 TO outptr DO Write(termout,xchr[outbuf[k]]);
Writeln(termout);
k:=outptr;
c:=32;
END
ELSE
IF(((d<65)OR((d>90)AND(d<97))OR(d>122))AND(outbuf[k-1]<>92))
THEN
BEGIN
k:=k+1;
c:=32;
END;
d:=c;
END;
Flushbuffer(k);
END;
{119}
PROCEDURE Outval(v:sixteenbits);
VAR
k:0..5;
BEGIN
k:=0;
REPEAT
dig[k]:=v MOD 10;
v:=v DIV 10;
k:=k+1;
UNTIL v=0;
REPEAT
k:=k-1;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=dig[k]+48;
END;
UNTIL k=0;
END;
{120}
PROCEDURE Outname(p:namepointer);
VAR
k:0..maxbytes;
w:0..1;
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
w:=p MOD 2;
FOR k:=bytestart[p]TO bytestart[p+2]-1 DO
BEGIN
IF bytemem[w,k]=95 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[w,k];
END;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=125;
END;
END;
{121}
PROCEDURE Copylimbo;
LABEL
10;
VAR
c:asciicode;
BEGIN
WHILE true DO
IF loc>limit THEN
BEGIN
Finishline;
Getline;
IF inputhasende THEN
GOTO 10;
END
ELSE
BEGIN
buffer[limit+1]:=64;
{122}
WHILE buffer[loc]<>64 DO
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=buffer[loc];
END;
loc:=loc+1;
END;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=buffer[loc-1];
IF(c=32)OR(c=9)OR(c=42)THEN
GOTO 10;
IF(c<>122)AND(c<>90)THEN
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
IF c<>64 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Double @ required outside of modules');
Error;
END;
END;
END;
END;
END;
10:
END;
{123}
FUNCTION Copytex:eightbits;
LABEL
30;
VAR
c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Finishline;
Getline;
IF inputhasende THEN
BEGIN
c:=146;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
{124}
REPEAT
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
IF c<>64 THEN
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=c;
END;
IF(outptr=1)AND((c=32)OR(c=9))THEN
outptr:=outptr-1;
END;
UNTIL c=64;
IF loc<=limit THEN
BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
GOTO 30;
END;
END;
30:
Copytex:=c;
END;
{125}
FUNCTION Copycomment(bal:eightbits):eightbits;
LABEL
30;
VAR
c:asciicode;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF inputhasende THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Input ended in mid-comment');
Error;
END;
END;
loc:=1;
{127}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
;
END;
END;
c:=buffer[loc];
loc:=loc+1;
IF c=124 THEN
GOTO 30;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=c;
tokptr:=tokptr+1;
END;
{126}
IF c=64 THEN
BEGIN
loc:=loc+1;
IF buffer[loc-1]<>64 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln
(termout);
Write(termout,'! Illegal use of @ in comment');
Error;
END;
END;
loc:=loc-2;
tokptr:=tokptr-1;
{127}
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
END;
REPEAT
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
END;
bal:=bal-1;
UNTIL bal=0;
GOTO 30;
;
END;
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN
BEGIN
BEGIN
IF tokptr+2>
maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[loc];
tokptr:=tokptr+1;
END;
loc:=loc+1;
END
ELSE
IF c=123 THEN
bal:=bal+1
ELSE
IF c=125 THEN
BEGIN
bal:=bal-1;
IF bal=0 THEN
GOTO 30;
END;
END;
30:
Copycomment:=bal;
END;
{129}{PROCEDURE PRINTCAT(C:EIGHTBITS);
BEGIN CASE C OF 1:WRITE(TERMOUT,'simp');
2:WRITE(TERMOUT,'math');
3:WRITE(TERMOUT,'intro');
4:WRITE(TERMOUT,'open');
5:WRITE(TERMOUT,'beginning');
6:WRITE(TERMOUT,'close');
7:WRITE(TERMOUT,'alpha');
8:WRITE(TERMOUT,'omega');
9:WRITE(TERMOUT,'semi');
10:WRITE(TERMOUT,'terminator');
11:WRITE(TERMOUT,'stmt');
12:WRITE(TERMOUT,'cond');
13:WRITE(TERMOUT,'clause');
14:WRITE(TERMOUT,'colon');
15:WRITE(TERMOUT,'exp');
16:WRITE(TERMOUT,'proc');
17:WRITE(TERMOUT,'casehead');
18:WRITE(TERMOUT,'recordhead');
19:WRITE(TERMOUT,'varhead');
20:WRITE(TERMOUT,'elsie');
21:WRITE(TERMOUT,'casey');
22:WRITE(TERMOUT,'module');
OTHERS:WRITE(TERMOUT,'UNKNOWN')END;
END;
}{135}{PROCEDURE PRINTTEXT(P:TEXTPOINTER);
VAR J:0..MAXTOKS;
R:0..10239;
BEGIN IF P>=TEXTPTR THEN WRITE(TERMOUT,'BAD')ELSE FOR J:=TOKSTART[P]TO
TOKSTART[P+1]-1 DO BEGIN R:=TOKMEM[J]MOD 10240;
CASE TOKMEM[J]DIV 10240 OF 1:BEGIN WRITE(TERMOUT,'\\',XCHR[123]);
PRINTID(R);
WRITE(TERMOUT,XCHR[125]);
END;
2:BEGIN WRITE(TERMOUT,'\&',XCHR[123]);
PRINTID(R);
WRITE(TERMOUT,XCHR[125]);
END;
3:BEGIN WRITE(TERMOUT,'<');
PRINTID(R);
WRITE(TERMOUT,'>');
END;
4:WRITE(TERMOUT,'[[',R:0,']]');
5:WRITE(TERMOUT,'|[[',R:0,']]|');
OTHERS:[136]CASE R OF 131:WRITE(TERMOUT,'\mathbin',XCHR[123]);
132:WRITE(TERMOUT,'\mathrel',XCHR[123]);
133:WRITE(TERMOUT,'\mathop',XCHR[123]);
134:WRITE(TERMOUT,'[ccancel]');
135:WRITE(TERMOUT,'[cancel]');
136:WRITE(TERMOUT,'[indent]');
137:WRITE(TERMOUT,'[outdent]');
139:WRITE(TERMOUT,'[backup]');
138:WRITE(TERMOUT,'[opt]');
140:WRITE(TERMOUT,'[break]');
141:WRITE(TERMOUT,'[force]');
142:WRITE(TERMOUT,'[fforce]');
143:WRITE(TERMOUT,'[quit]');
OTHERS:WRITE(TERMOUT,XCHR[R])END END;
END;
END;}
{161}PROCEDURE Red(j:sixteenbits;
k:eightbits;
c:eightbits;
d:integer);
VAR
i:0..maxscraps;
BEGIN
cat[j]:=c;
trans[j]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
IF k>1 THEN
BEGIN
FOR i:=j+k TO loptr DO
BEGIN
cat[i-k+1]:=cat[i];
trans[i-k+1]:=trans[i];
END;
loptr:=loptr-k+1;
END;
{162}
IF pp+d>=scrapbase THEN
pp:=pp+d
ELSE
pp:=scrapbase;
END;
{163}
PROCEDURE Sq(j:sixteenbits;
k:eightbits;
c:eightbits;
d:integer);
VAR
i:0..maxscraps;
BEGIN
IF k=1 THEN
BEGIN
cat[j]:=c;
{162}
IF pp+d>=scrapbase THEN
pp:=pp+d
ELSE
pp:=scrapbase;
END
ELSE
BEGIN
FOR i:=j TO j+k-1 DO
BEGIN
tokmem[tokptr]:=40960+trans[i]
;
tokptr:=tokptr+1;
END;
Red(j,k,c,d);
END;
END;
{167}{PROCEDURE PROD(N:EIGHTBITS);
VAR K:1..MAXSCRAPS;
BEGIN IF TRACING=2 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,N:0,':');
END;
FOR K:=SCRAPBASE TO LOPTR DO BEGIN IF K=PP THEN WRITE(TERMOUT,'*')ELSE
WRITE(TERMOUT,' ');
PRINTCAT(CAT[K]);
END;
IF HIPTR<=SCRAPPTR THEN WRITE(TERMOUT,'...');
END;
END;}
{168}{139}
PROCEDURE Fivecases;
LABEL
31;
BEGIN
CASE cat[pp]OF
5:{141}IF cat[pp+1]=6 THEN
BEGIN
IF(cat[pp+2]=10)OR
(cat[pp+2]=11)THEN
BEGIN
Sq(pp,3,11,-2);
{PROD(5)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,5,-1);
{PROD(6)};
GOTO 31;
END;
3:{148}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=55;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(17)};
GOTO 31;
END;
2:{149}IF cat[pp+1]=6 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
Red(pp,1,11,-2);
{PROD(18)};
GOTO 31;
END
ELSE
IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,3,-3);
{PROD(19)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(20)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(21)};
GOTO 31;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(22)};
GOTO 31;
END
ELSE
IF cat[pp+1]=10 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(23)};
GOTO 31;
END;
4:{151}IF(cat[pp+1]=17)AND(cat[pp+2]=6)THEN
BEGIN
tokmem[tokptr]:=40960+
trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,2,-1);
{PROD(26)};
GOTO 31;
END
ELSE
IF cat[pp+1]=6 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,2,-1);
{PROD(27)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
{152}
BEGIN
IF(cat[pp+2]=17)AND(cat[pp+3]=6)
THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
Red(pp,4,2,-1);
{PROD(28)};
GOTO 31;
END
ELSE
IF cat[pp+2]=6 THEN
BEGIN
Sq(pp,3,2,-1);
{PROD(29)};
GOTO 31;
END
ELSE
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(30)};
GOTO 31;
END
ELSE
IF cat[pp+2]=16 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[
tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,3,2,0);
{PROD(31)};
GOTO 31;
END;
END
ELSE
IF cat[pp+2]=9 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=53;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(32)};
GOTO 31;
END
ELSE
IF cat[pp+2]=19 THEN
BEGIN
IF cat[pp+3]=3 THEN
BEGIN
tokmem[
tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,3,2,0);
{PROD(31)};
GOTO 31;
END;
END;
END
ELSE
IF cat[pp+1]=16 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[
tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(34)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(35)};
GOTO 31;
END
ELSE
IF(cat[pp+1]=11)AND(cat[pp+2]=6)THEN
BEGIN
tokmem[tokptr]:=
40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,2,-1);
{PROD(36)};
GOTO 31;
END
ELSE
IF cat[pp+1]=19 THEN
BEGIN
IF cat[pp+2]=3 THEN
BEGIN
tokmem[
tokptr]:=133;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp+1,2,2,0);
{PROD(37)};
GOTO 31;
END;
END;
1:{156}IF cat[pp+1]=6 THEN
BEGIN
Sq(pp,1,11,-2);
{PROD(43)};
GOTO 31;
END
ELSE
IF cat[pp+1]=14 THEN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,3,-3);
{PROD(44)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
Sq(pp,2,2,-1);
{PROD(45)};
GOTO 31;
END
ELSE
IF cat[pp+1]=22 THEN
BEGIN
Sq(pp,2,22,0);
{PROD(46)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp,2,1,-2);
{PROD(47)};
GOTO 31;
END
ELSE
IF cat[pp+1]=10 THEN
BEGIN
Sq(pp,2,11,-2);
{PROD(48)};
GOTO 31;
END;
OTHERS:
END;
pp:=pp+1;
31:
END;
FUNCTION Translate:textpointer;
LABEL
30,31;
VAR
i:1..maxscraps;
j:0..maxscraps;
k:0..longbufsize;
BEGIN
pp:=scrapbase;
loptr:=pp-1;
hiptr:=pp;
{172}{IF TRACING=2 THEN BEGIN BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'Tracing after l.',LINE:0,':');
END;
IF LOC>50 THEN BEGIN WRITE(TERMOUT,'...');
FOR K:=LOC-50 TO LOC DO WRITE(TERMOUT,XCHR[BUFFER[K-1]]);
END ELSE FOR K:=1 TO LOC DO WRITE(TERMOUT,XCHR[BUFFER[K-1]]);
END};
{164}
WHILE true DO
BEGIN{165}
IF loptr<pp+3 THEN
BEGIN
REPEAT
IF hiptr<=
scrapptr THEN
BEGIN
loptr:=loptr+1;
cat[loptr]:=cat[hiptr];
trans[loptr]:=trans[hiptr];
hiptr:=hiptr+1;
END;
UNTIL(hiptr>scrapptr)OR(loptr=pp+3);
FOR i:=loptr+1 TO pp+3 DO cat[i]:=0;
END;
IF(tokptr+8>maxtoks)OR(textptr+4>maxtexts)THEN
BEGIN{IF TOKPTR>MAXTOKPTR
THEN MAXTOKPTR:=TOKPTR;
IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;
}
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token/text',' capacity exceeded');
Error;
Quit;
END;
END;
IF pp>loptr THEN
GOTO 30;
{138}
IF cat[pp]<7 THEN
Fivecases
ELSE
BEGIN
CASE cat[pp]OF
7:{140}IF cat
[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,2,0);
{PROD(1)};
GOTO 31;
END
ELSE
IF cat[pp+2]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,13,-2);
{PROD(2)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=8 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,13,-2);
{PROD(3)};
GOTO 31;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
Sq(pp+1,1,2,0);
{PROD(4)};
GOTO 31;
END;
17:{142}IF cat[pp+1]=21 THEN
BEGIN
IF cat[pp+2]=13 THEN
BEGIN
tokmem[
tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,17,0);
{PROD(7)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=6 THEN
BEGIN
IF cat[pp+2]=10 THEN
BEGIN
tokmem[
tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,11,-2);
{PROD(8)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,17,0);
{PROD(9)};
GOTO 31;
END;
21:{143}IF cat[pp+1]=13 THEN
BEGIN
Sq(pp,2,17,0);
{PROD(10)};
GOTO 31;
END;
13:{144}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(11)};
GOTO 31;
END;
12:{145}IF(cat[pp+1]=13)AND(cat[pp+2]=11)THEN
IF cat[pp+3]=20 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
Red(pp,4,13,-2);
{PROD(12)};
GOTO 31;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,3,11,-2);
{PROD(13)};
GOTO 31;
END;
20:{146}BEGIN
Sq(pp,1,3,-3);
{PROD(14)};
GOTO 31;
END;
15:{147}IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=1 THEN
BEGIN
tokmem[
tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp,3,2,-1);
{PROD(15)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
Red(pp,2,2,-1);
{PROD(16)};
GOTO 31;
END;
22:{150}IF(cat[pp+1]=10)OR(cat[pp+1]=9)THEN
BEGIN
tokmem[tokptr]:=40960+
trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(24)};
GOTO 31;
END
ELSE
BEGIN
Sq(pp,1,1,-2);
{PROD(25)};
GOTO 31;
END;
16:{153}IF cat[pp+1]=5 THEN
BEGIN
IF(cat[pp+2]=6)AND(cat[pp+3]=10)THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=137;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+3];
tokptr:=tokptr+1;
Red(pp,4,11,-2);
{PROD(38)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,16,-2);
{PROD(39)};
GOTO 31;
END;
18:{154}IF(cat[pp+1]=3)AND(cat[pp+2]=21)THEN
BEGIN
tokmem[tokptr]:=
40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp,3,21,-2);
{PROD(40)};
GOTO 31;
END
ELSE
BEGIN
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
Red(pp,1,17,0);
{PROD(41)};
GOTO 31;
END;
9:{155}BEGIN
Sq(pp,1,10,-3);
{PROD(42)};
GOTO 31;
END;
11:{157}IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,11,-2);
{PROD(49)};
GOTO 31;
END;
10:{158}BEGIN
Sq(pp,1,11,-2);
{PROD(50)};
GOTO 31;
END;
19:{159}IF cat[pp+1]=5 THEN
BEGIN
Sq(pp,1,11,-2);
{PROD(51)};
GOTO 31;
END
ELSE
IF cat[pp+1]=2 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
tokmem[
tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+2];
tokptr:=tokptr+1;
Red(pp+1,2,3,+1);
{PROD(52)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=1 THEN
BEGIN
IF cat[pp+2]=14 THEN
BEGIN
Sq(pp+1,2,
3,+1);
{PROD(53)};
GOTO 31;
END;
END
ELSE
IF cat[pp+1]=11 THEN
BEGIN
tokmem[tokptr]:=40960+trans[pp];
tokptr:=tokptr+1;
tokmem[tokptr]:=140;
tokptr:=tokptr+1;
tokmem[tokptr]:=40960+trans[pp+1];
tokptr:=tokptr+1;
Red(pp,2,19,-2);
{PROD(54)};
GOTO 31;
END;
OTHERS:
END;
pp:=pp+1;
31:
END;
END;
30:;
IF(loptr=scrapbase)AND(cat[loptr]<>2)THEN
Translate:=trans[loptr]
ELSE
{
170}
BEGIN{171}{IF(LOPTR>SCRAPBASE)AND(TRACING=1)THEN BEGIN BEGIN WRITELN
(TERMOUT);
WRITE(TERMOUT,'Irreducible scrap sequence in module ',MODULECOUNT:0);
END;
WRITELN(TERMOUT,':');
FOR J:=SCRAPBASE TO LOPTR DO BEGIN WRITE(TERMOUT,' ');
PRINTCAT(CAT[J]);
END;
END;};
FOR j:=scrapbase TO loptr DO
BEGIN
IF j<>scrapbase THEN
BEGIN
tokmem[
tokptr]:=32;
tokptr:=tokptr+1;
END;
IF cat[j]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=40960+trans[j];
tokptr:=tokptr+1;
IF cat[j]=2 THEN
BEGIN
tokmem[tokptr]:=36;
tokptr:=tokptr+1;
END;
IF tokptr+6>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
END;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
Translate:=textptr-1;
END;
END;
{173}{185}PROCEDURE Appcomment;
BEGIN
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
IF(scrapptr<scrapbase)OR(cat[scrapptr]<8)OR(cat[scrapptr]>10)THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END
ELSE
BEGIN
tokmem[tokptr]:=40960+trans[scrapptr];
tokptr:=tokptr+1;
END;
tokmem[tokptr]:=textptr+40959;
tokptr:=tokptr+1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{176}
PROCEDURE Easycases;
BEGIN
CASE nextcontrol OF
6:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=105;
tokptr:=tokptr+1;
tokmem[tokptr]:=110;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
32:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
35,36,37,94:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
0,124,131,132,133:;
40,91:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=4;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
41,93:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
42:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=97;
tokptr:=tokptr+1;
tokmem[tokptr]:=115;
tokptr:=tokptr+1;
tokmem[tokptr]:=116;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
44:BEGIN
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=57;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
46,48,49,50,51,52,53,54,55,56,57:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
59:BEGIN
tokmem[tokptr]:=59;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
58:BEGIN
tokmem[tokptr]:=58;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=14;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{178}26:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=73;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
28:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=76;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
29:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=71;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
30:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
4:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=87;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
31:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=86;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
5:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=82;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
24:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=75;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
11:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=94;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
128:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=69;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=15;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
9:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=66;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
10:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=84;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
12:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=79;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
135:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=41;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
136:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=44;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
137:BEGIN
tokmem[tokptr]:=138;
tokptr:=tokptr+1;
tokmem[tokptr]:=48;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
138:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
139:BEGIN
tokmem[tokptr]:=142;
tokptr:=tokptr+1;
Appcomment;
END;
140:BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
BEGIN
tokmem[tokptr]:=134;
tokptr:=tokptr+1;
Appcomment;
END;
END;
141:BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
127:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=74;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
OTHERS:BEGIN
tokmem[tokptr]:=nextcontrol;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END
END;
END;
{182}PROCEDURE Subcases(p:namepointer);
BEGIN
CASE ilk[p]OF
0:BEGIN
tokmem[tokptr]:=10240+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
4:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
7:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
8:BEGIN
tokmem[tokptr]:=131;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
9:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=8;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
12:BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
13:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
16:BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
20:BEGIN
tokmem[tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
END;
PROCEDURE Pascalparse;
LABEL
21,10;
VAR
j:0..longbufsize;
p:namepointer;
BEGIN
WHILE nextcontrol<142 DO
BEGIN{175}{177}
IF(scrapptr+4>maxscraps)OR
(tokptr+6>maxtoks)OR(textptr+4>maxtexts)THEN
BEGIN{IF SCRAPPTR>MAXSCRPTR
THEN MAXSCRPTR:=SCRAPPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;
IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;}
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','scrap/token/text',' capacity exceeded');
Error;
Quit;
END;
END;
21:
CASE nextcontrol OF
129:{179}BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=46;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
j:=idfirst;
WHILE j<idloc DO
BEGIN
CASE buffer[j]OF
32,92,35,37,36,94,39,96,123,125,
126,38,95,24,14,1,22,26,11,29,28:BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
END;
64:IF buffer[j+1]=64 THEN
j:=j+1
ELSE
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Double @ should be used in strings');
Error;
END;
END;
25:;
OTHERS:IF buffer[j]<32 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! This character shouldn''t be used in strings');
Error;
END;
END
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
j:=j+1;
END;
BEGIN
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
130:{181}BEGIN
p:=Idlookup(0);
CASE ilk[p]OF
0,4,7,8,9,12,13,16,20:Subcases(p);
{183}5:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
6:BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=21;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
10:BEGIN{184}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)AND(cat[
scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=20;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
11:BEGIN{184}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)AND(cat[
scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
14:BEGIN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=12;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
23:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=33;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=7;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=8;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
17:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=16;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=32;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
18:BEGIN
BEGIN
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=18;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
19:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=136;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=5;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
21:BEGIN{184}
IF(scrapptr<scrapbase)OR((cat[scrapptr]<>10)AND(cat[
scrapptr]<>9))THEN
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=10;
trans[scrapptr]:=0;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=6;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=13;
trans[scrapptr]:=0;
END;
END;
22:BEGIN
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
tokmem[tokptr]:=20480+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=135;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=19;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=0;
END;
END;
OTHERS:BEGIN
nextcontrol:=ilk[p]-24;
GOTO 21;
END
END;
END;
134:{180}BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=104;
tokptr:=tokptr+1;
tokmem[tokptr]:=98;
tokptr:=tokptr+1;
tokmem[tokptr]:=111;
tokptr:=tokptr+1;
tokmem[tokptr]:=120;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
FOR j:=idfirst TO idloc-1 DO
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=buffer[j];
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=1;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
END;
OTHERS:Easycases
END;
nextcontrol:=Getnext;
IF(nextcontrol=124)OR(nextcontrol=123)THEN
GOTO 10;
END;
10:
END;
{186}
FUNCTION Pascaltransl:textpointer;
VAR
p:textpointer;
savebase:0..maxscraps;
BEGIN
savebase:=scrapbase;
scrapbase:=scrapptr+1;
Pascalparse;
IF nextcontrol<>124 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Missing "|" after PASCAL text');
Error;
END;
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=135;tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
{IF SCRAPPTR>MAXSCRPTR THEN MAXSCRPTR:=SCRAPPTR;}scrapptr:=scrapbase-1;
scrapbase:=savebase;
Pascaltransl:=p;
END;
{187}PROCEDURE Outerparse;
VAR
bal:eightbits;
p,q:textpointer;
BEGIN
WHILE nextcontrol<142 DO
IF nextcontrol<>123 THEN
Pascalparse
ELSE
BEGIN{188}
IF(tokptr+7>maxtoks)OR(textptr+3>maxtexts)OR(scrapptr>=
maxscraps)THEN
BEGIN{IF SCRAPPTR>MAXSCRPTR THEN MAXSCRPTR:=SCRAPPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;
IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;}
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token/text/scrap',' capacity exceeded');
Error;
Quit;
END;
END;
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=67;
tokptr:=tokptr+1;
tokmem[tokptr]:=123;
tokptr:=tokptr+1;
bal:=Copycomment(1);
nextcontrol:=124;
WHILE bal>0 DO
BEGIN
p:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
q:=Pascaltransl;
tokmem[tokptr]:=40960+p;
tokptr:=tokptr+1;
tokmem[tokptr]:=51200+q;
tokptr:=tokptr+1;
IF nextcontrol=124 THEN
bal:=Copycomment(bal)
ELSE
bal:=0;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
Appcomment;
END;
END;
{193}
PROCEDURE Pushlevel(p:textpointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','stack',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
IF stackptr>0 THEN
stack[stackptr]:=curstate;
stackptr:=stackptr+1;
{IF STACKPTR>MAXSTACKPTR THEN MAXSTACKPTR:=STACKPTR;
}curstate.tokfield:=tokstart[p];
curstate.endfield:=tokstart[p+1];
END;
END;
{195}
FUNCTION Getoutput:eightbits;
LABEL
20;
VAR
a:sixteenbits;
BEGIN
20:
WHILE curstate.tokfield=curstate.endfield DO
BEGIN
stackptr:=
stackptr-1;
curstate:=stack[stackptr];
END;
a:=tokmem[curstate.tokfield];
curstate.tokfield:=curstate.tokfield+1;
IF a>=256 THEN
BEGIN
curname:=a MOD 10240;
CASE a DIV 10240 OF
2:a:=129;
3:a:=128;
4:BEGIN
Pushlevel(curname);
GOTO 20;
END;
5:BEGIN
Pushlevel(curname);
curstate.modefield:=inner;
GOTO 20;
END;
OTHERS:a:=130
END;
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}Getoutput:=a;
END;
{196}
PROCEDURE Makeoutput;
FORWARD;
PROCEDURE Outputpascal;
VAR
savetokptr,savetextptr,savenextcont:sixteenbits;
p:textpointer;
BEGIN
savetokptr:=tokptr;
savetextptr:=textptr;
savenextcont:=nextcontrol;
nextcontrol:=124;
p:=Pascaltransl;
tokmem[tokptr]:=p+51200;
tokptr:=tokptr+1;
Makeoutput;
{IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;}
textptr:=savetextptr;
tokptr:=savetokptr;
nextcontrol:=savenextcont;
END;
{197}
PROCEDURE Makeoutput;
LABEL
21,10,31;
VAR
a:eightbits;
b:eightbits;
k,klimit:0..maxbytes;
w:0..1;
j:0..longbufsize;
stringdelimi:asciicode;
saveloc,savelimit:0..longbufsize;
curmodname:namepointer;
savemode:mode;
BEGIN
tokmem[tokptr]:=143;
tokptr:=tokptr+1;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
Pushlevel(textptr-1);
WHILE true DO
BEGIN
a:=Getoutput;
21:
CASE a OF
143:GOTO 10;
130,129:{198}BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF a=130 THEN
IF bytestart[curname+2]-bytestart[curname]=1 THEN
BEGIN
IF
outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=124;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END;
IF bytestart[curname+2]-bytestart[curname]=1 THEN
BEGIN
IF outptr=
linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=bytemem[curname MOD 2,bytestart[curname]];
END
ELSE
Outname(curname);
END;
128:{202}BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
IF xmem[xref[curname]].numfield>=10240 THEN
Outval(xmem[xref[curname]].
numfield-10240)
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=48;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=58;
END;
{203}k:=bytestart[curname];
w:=curname MOD 2;
klimit:=bytestart[curname+2];
curmodname:=curname;
WHILE k<klimit DO
BEGIN
b:=bytemem[w,k];
k:=k+1;
IF b=64 THEN
{204}
BEGIN
IF bytemem[w,k]<>64 THEN
BEGIN
BEGIN
Writeln(
termout);
Write(termout,'! Illegal control code in module name:');
END;
BEGIN
Writeln(termout);
Write(termout,'<');
END;
Printid(curmodname);
Write(termout,'> ');
END;
k:=k+1;
END;
IF b<>124 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b;
END
ELSE
BEGIN{205}
j:=limit+1;
buffer[j]:=124;
stringdelimi:=0;
WHILE true DO
BEGIN
IF k>=klimit THEN
BEGIN
BEGIN
Writeln(termout);
Write(termout,'! PASCAL text in module name didn''t end:');
END;
BEGIN
Writeln(termout);
Write(termout,'<');
END;
Printid(curmodname);
Write(termout,'> ');
GOTO 31;
END;
b:=bytemem[w,k];
k:=k+1;
IF b=64 THEN
{206}
BEGIN
IF j>longbufsize-4 THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','buffer',' capacity exceeded');
Error;
Quit;
END;
buffer[j+1]:=64;
buffer[j+2]:=bytemem[w,k];
j:=j+2;
k:=k+1;
END
ELSE
BEGIN
IF(b=34)OR(b=39)THEN
IF stringdelimi=0 THEN
stringdelimi
:=b
ELSE
IF stringdelimi=b THEN
stringdelimi:=0;
IF(b<>124)OR(stringdelimi<>0)THEN
BEGIN
IF j>longbufsize-3 THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','buffer',' capacity exceeded');
Error;
Quit;
END;
j:=j+1;
buffer[j]:=b;
END
ELSE
GOTO 31;
END;
END;
31:;
saveloc:=loc;
savelimit:=limit;
loc:=limit+2;
limit:=j+1;
buffer[limit]:=124;
Outputpascal;
loc:=saveloc;
limit:=savelimit;
END;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=88;
END;
END;
131,133,132:{199}BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=109;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=104;
END;
IF a=131 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=98;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END
ELSE
IF a=132 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=108;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=123;
END;
END;
135:BEGIN
REPEAT
a:=Getoutput;
UNTIL(a<139)OR(a>142);
GOTO 21;
END;
134:BEGIN
REPEAT
a:=Getoutput;
UNTIL((a<139)AND(a<>32))OR(a>142);
GOTO 21;
END;
136,137,138,139,140,141,142:{200}IF a<140 THEN
BEGIN
IF curstate.
modefield=outer THEN
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a-87;
END;
IF a=138 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=Getoutput;
END
END
ELSE
IF a=138 THEN
b:=Getoutput
END
ELSE
{201}
BEGIN
b:=a;
savemode:=curstate.modefield;
WHILE true DO
BEGIN
a:=Getoutput;
IF(a=135)OR(a=134)THEN
GOTO 21;
IF((a<>32)AND(a<140))OR(a>142)THEN
BEGIN
IF savemode=outer THEN
BEGIN
IF
outptr>3 THEN
IF(outbuf[outptr]=80)AND(outbuf[outptr-1]=92)AND(outbuf[
outptr-2]=89)AND(outbuf[outptr-3]=92)THEN
GOTO 21;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=b-87;
END;
IF a<>143 THEN
Finishline;
END
ELSE
IF(a<>143)AND(curstate.modefield=inner)THEN
BEGIN
IF outptr=
linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
GOTO 21;
END;
IF a>b THEN
b:=a;
END;
END;
OTHERS:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=a;
END
END;
END;
10:
END;
{213}
PROCEDURE Finishpascal;
VAR
p:textpointer;
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=80;
END;
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
END;
Appcomment;
p:=Translate;
tokmem[tokptr]:=p+40960;
tokptr:=tokptr+1;
Makeoutput;
IF outptr>1 THEN
IF outbuf[outptr-1]=92 THEN
IF outbuf[outptr]=54 THEN
outptr:=outptr-2
ELSE
IF outbuf[outptr]=55 THEN
outbuf[outptr]:=89;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=112;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=114;
END;
Finishline;
{IF TEXTPTR>MAXTXTPTR THEN MAXTXTPTR:=TEXTPTR;
IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;
IF SCRAPPTR>MAXSCRPTR THEN MAXSCRPTR:=SCRAPPTR;}tokptr:=1;
textptr:=1;
scrapptr:=0;
END;
{221}
PROCEDURE Footnote(flag:sixteenbits);
LABEL
30;
VAR
p,q,r:0..maxrefs;
BEGIN
Finishline;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF flag=0 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=85;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=65;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=101;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=99;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=116;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
{222}q:=0;
p:=curxref;
REPEAT
r:=xmem[p].xlinkfield;
xmem[p].xlinkfield:=q;
q:=p;
p:=r;
UNTIL xmem[p].numfield<=flag;
xmem[curxref].xlinkfield:=p;;
{223}p:=q;
IF p<>curxref THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=115;
END;
WHILE true DO
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
Outval(xmem[p].numfield-flag);
IF p=curxref THEN
GOTO 30;
p:=xmem[p].xlinkfield;
IF(p<>curxref)OR(p<>xmem[q].xlinkfield)THEN
BEGIN
IF outptr=linelength
THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
END;
IF p=curxref THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=97;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=100;
END;
END;
30:;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
END;
{232}
PROCEDURE Unbucket(d:eightbits);
VAR
c:asciicode;
BEGIN
FOR c:=100 DOWNTO 0 DO
IF bucket[collate[c]]>0 THEN
BEGIN
IF
scrapptr>maxscraps THEN
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','sorting',' capacity exceeded');
Error;
Quit;
END;
scrapptr:=scrapptr+1;
{IF SCRAPPTR>MAXSORTPTR THEN MAXSORTPTR:=SCRAPPTR;
}
IF c=0 THEN
cat[scrapptr]:=255
ELSE
cat[scrapptr]:=d;
trans[scrapptr]:=bucket[collate[c]];
bucket[collate[c]]:=0;
END;
END;
{240}
PROCEDURE Modprint(p:namepointer);
BEGIN
IF p>0 THEN
BEGIN
Modprint(link[p]);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=43;
END;
tokptr:=1;
textptr:=1;
scrapptr:=0;
stackptr:=0;
curstate.modefield:=outer;
tokmem[tokptr]:=p+30720;
tokptr:=tokptr+1;
Makeoutput;
Finishline;
Modprint(ilk[p]);
END;
END;
{244}{PROCEDURE DEBUGHELP;
LABEL 889,888,10;
VAR K:SIXTEENBITS;
BEGIN DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;
DEBUGSKIPPED:=0;
GOTO 889;
888:['*************breakpoint*************';
'***********for**debugging***********'];
889:WHILE TRUE DO BEGIN WRITE(TERMOUT,'#');
BREAK(TERMOUT);
READ(TERMIN,DDT);
IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN GOTO 888;
READ(TERMIN,DD);
CASE DDT OF 1:PRINTID(DD);
2:PRINTTEXT(DD);
3:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[MODTEXT[K]]);
5:FOR K:=1 TO OUTPTR DO WRITE(TERMOUT,XCHR[OUTBUF[K]]);
6:FOR K:=1 TO DD DO BEGIN PRINTCAT(CAT[K]);
WRITE(TERMOUT,' ');
END;
OTHERS:WRITE(TERMOUT,'?')END;
END;
10:END;}{245}
PROCEDURE Phasei;
BEGIN{98}
phaseone:=true;
Resetinput;
modulecount:=0;
REPEAT
Skiplimbo;
IF NOT inputhasende THEN
REPEAT{99}
IF modulecount<10239 THEN
modulecount
:=modulecount+1
ELSE
BEGIN
Writeln(termout);
Write(termout,'! Sorry, ','module number',' capacity exceeded');
Error;
Quit;
END;
IF buffer[loc-1]=42 THEN
BEGIN
Write(termout,'*',modulecount:0);
Break(termout);
END;
{102}
REPEAT
nextcontrol:=Skiptex;
CASE nextcontrol OF
126:xrefswitch:=10240;
125:xrefswitch:=0;
124:Pascalxref;
131,132,133,145:BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
IF nextcontrol<>145 THEN
Newxref(Idlookup(nextcontrol-130));
END;
OTHERS:
END;
UNTIL nextcontrol>=142;
{104}
WHILE nextcontrol<=143 DO
BEGIN
xrefswitch:=10240;
IF nextcontrol=143 THEN
nextcontrol:=Getnext
ELSE
{105}
BEGIN
nextcontrol
:=Getnext;
IF nextcontrol=130 THEN
BEGIN
lhs:=Idlookup(0);
ilk[lhs]:=0;
Newxref(lhs);
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
rhs:=Idlookup(0);
ilk[lhs]:=ilk[rhs];
ilk[rhs]:=0;
Newxref(rhs);
ilk[rhs]:=ilk[lhs];
nextcontrol:=Getnext;
END;
END;
END;
END;
Outerxref;
END;
{106}
IF nextcontrol<=145 THEN
BEGIN
IF nextcontrol=144 THEN
modxrefswitc
:=0
ELSE
modxrefswitc:=10240;
REPEAT
IF nextcontrol=145 THEN
Newmodxref(curmodule);
nextcontrol:=Getnext;
Outerxref;
UNTIL nextcontrol>145;
END;
UNTIL nextcontrol=146;
UNTIL inputhasende;
phaseone:=false;
{109}Modcheck(ilk[0]);;
END;
PROCEDURE Phaseii;
BEGIN{207}
Resetinput;
BEGIN
Writeln(termout);
Write(termout,'Writing the output file...');
END;
modulecount:=0;
REPEAT
Copylimbo;
IF NOT inputhasende THEN
BEGIN
REPEAT{209}
modulecount:=modulecount+1;
{210}Finishline;
Flushbuffer(0);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
IF buffer[loc-1]<>42 THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=77;
END
ELSE
BEGIN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=78;
END;
Write(termout,'*',modulecount:0);
Break(termout);
END;
Outval(modulecount);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
saveline:=outline;
saveplace:=outptr;
{211}
REPEAT
nextcontrol:=Copytex;
CASE nextcontrol OF
124:BEGIN
stackptr:=0;
curstate.modefield:=outer;
Outputpascal;
END;
64:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=64;
END;
12:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=79;
END;
134,131,132,133,145:BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
IF nextcontrol=134 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout
);
Write(termout,'! TeX string should be in PASCAL text only');
Error;
END;
END;
END;
9,10,135,136,137,138,139,140,127,141:BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! You can''t do that in TeX text');
Error;
END;
END;
OTHERS:
END;
UNTIL nextcontrol>=142;
{212}
IF nextcontrol<=143 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>
outptr)THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
saveline:=outline;
saveplace:=outptr;
END;
WHILE nextcontrol<=143 DO
BEGIN
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=143 THEN
{214}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=68;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
IF nextcontrol<>130 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(
termout);
Write(termout,'! Improper macro definition');
Error;
END;
END
ELSE
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
END
ELSE
{215}
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=70;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=3;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
IF nextcontrol=30 THEN
BEGIN
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
IF nextcontrol=130 THEN
BEGIN
BEGIN
tokmem[tokptr]:=10240+Idlookup(0);
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=0;
END;
nextcontrol:=Getnext;
END;
END;
END;
IF scrapptr<>5 THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Improper format definition');
Error;
END;
END;
END;
Outerparse;
Finishpascal;
END;
{217}thismodule:=0;
IF nextcontrol<=145 THEN
BEGIN
IF(saveline<>outline)OR(saveplace<>outptr
)THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=89;
END;
stackptr:=0;
curstate.modefield:=outer;
IF nextcontrol=144 THEN
nextcontrol:=Getnext
ELSE
BEGIN
thismodule:=
curmodule;
{218}
REPEAT
nextcontrol:=Getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30)THEN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! You need an = sign after the module name');
Error;
END;
END
ELSE
nextcontrol:=Getnext;
IF outptr>1 THEN
IF(outbuf[outptr]=89)AND(outbuf[outptr-1]=92)THEN
BEGIN
tokmem[tokptr]:=139;
tokptr:=tokptr+1;
END;
BEGIN
tokmem[tokptr]:=30720+thismodule;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
curxref:=xref[thismodule];
IF xmem[curxref].numfield<>modulecount+10240 THEN
BEGIN
BEGIN
tokmem[
tokptr]:=132;
tokptr:=tokptr+1;
tokmem[tokptr]:=43;
tokptr:=tokptr+1;
tokmem[tokptr]:=125;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
thismodule:=0;
END;
BEGIN
tokmem[tokptr]:=92;
tokptr:=tokptr+1;
tokmem[tokptr]:=83;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=2;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
BEGIN
tokmem[tokptr]:=141;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=9;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
;
END;
WHILE nextcontrol<=145 DO
BEGIN
Outerparse;
{219}
IF nextcontrol<145 THEN
BEGIN
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! You can''t do that in PASCAL text');
Error;
END;
END;
nextcontrol:=Getnext;
END
ELSE
IF nextcontrol=145 THEN
BEGIN
BEGIN
tokmem[tokptr]:=30720+
curmodule;
tokptr:=tokptr+1;
scrapptr:=scrapptr+1;
cat[scrapptr]:=22;
trans[scrapptr]:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
nextcontrol:=Getnext;
END;
END;
Finishpascal;
END;
{220}
IF thismodule>0 THEN
BEGIN
curxref:=xmem[curxref].xlinkfield;
IF xmem[curxref].numfield>=10240 THEN
BEGIN
Footnote(10240);
curxref:=xmem[curxref].xlinkfield;
END;
IF curxref<>0 THEN
Footnote(0);
END;
UNTIL nextcontrol=146;
END;
UNTIL inputhasende;
;
END;
BEGIN
Initialize;
Writeln(termout,'This is WEAVE, Version 0.97');
{59}idloc:=10;
idfirst:=7;
buffer[7]:=97;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(28);
idfirst:=5;
buffer[5]:=97;
buffer[6]:=114;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=121;
curname:=Idlookup(4);
idfirst:=5;
buffer[5]:=98;
buffer[6]:=101;
buffer[7]:=103;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(5);
idfirst:=6;
buffer[6]:=99;
buffer[7]:=97;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(6);
idfirst:=5;
buffer[5]:=99;
buffer[6]:=111;
buffer[7]:=110;
buffer[8]:=115;
buffer[9]:=116;
curname:=Idlookup(7);
idfirst:=7;
buffer[7]:=100;
buffer[8]:=105;
buffer[9]:=118;
curname:=Idlookup(8);
idfirst:=8;
buffer[8]:=100;
buffer[9]:=111;
curname:=Idlookup(9);
idfirst:=4;
buffer[4]:=100;
buffer[5]:=111;
buffer[6]:=119;
buffer[7]:=110;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(20);
idfirst:=6;
buffer[6]:=101;
buffer[7]:=108;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(10);
idfirst:=7;
buffer[7]:=101;
buffer[8]:=110;
buffer[9]:=100;
curname:=Idlookup(11);
idfirst:=6;
buffer[6]:=102;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(4);
idfirst:=7;
buffer[7]:=102;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(12);
idfirst:=2;
buffer[2]:=102;
buffer[3]:=117;
buffer[4]:=110;
buffer[5]:=99;
buffer[6]:=116;
buffer[7]:=105;
buffer[8]:=111;
buffer[9]:=110;
curname:=Idlookup(17);
idfirst:=6;
buffer[6]:=103;
buffer[7]:=111;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(13);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=102;
curname:=Idlookup(14);
idfirst:=8;
buffer[8]:=105;
buffer[9]:=110;
curname:=Idlookup(30);
idfirst:=5;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=98;
buffer[8]:=101;
buffer[9]:=108;
curname:=Idlookup(7);
idfirst:=7;
buffer[7]:=109;
buffer[8]:=111;
buffer[9]:=100;
curname:=Idlookup(8);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(16);
idfirst:=7;
buffer[7]:=110;
buffer[8]:=111;
buffer[9]:=116;
curname:=Idlookup(29);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=102;
curname:=Idlookup(9);
idfirst:=8;
buffer[8]:=111;
buffer[9]:=114;
curname:=Idlookup(55);
idfirst:=4;
buffer[4]:=112;
buffer[5]:=97;
buffer[6]:=99;
buffer[7]:=107;
buffer[8]:=101;
buffer[9]:=100;
curname:=Idlookup(13);
idfirst:=1;
buffer[1]:=112;
buffer[2]:=114;
buffer[3]:=111;
buffer[4]:=99;
buffer[5]:=101;
buffer[6]:=100;
buffer[7]:=117;
buffer[8]:=114;
buffer[9]:=101;
curname:=Idlookup(17);
idfirst:=3;
buffer[3]:=112;
buffer[4]:=114;
buffer[5]:=111;
buffer[6]:=103;
buffer[7]:=114;
buffer[8]:=97;
buffer[9]:=109;
curname:=Idlookup(17);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=99;
buffer[7]:=111;
buffer[8]:=114;
buffer[9]:=100;
curname:=Idlookup(18);
idfirst:=4;
buffer[4]:=114;
buffer[5]:=101;
buffer[6]:=112;
buffer[7]:=101;
buffer[8]:=97;
buffer[9]:=116;
curname:=Idlookup(19);
idfirst:=7;
buffer[7]:=115;
buffer[8]:=101;
buffer[9]:=116;
curname:=Idlookup(4);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=104;
buffer[8]:=101;
buffer[9]:=110;
curname:=Idlookup(9);
idfirst:=8;
buffer[8]:=116;
buffer[9]:=111;
curname:=Idlookup(20);
idfirst:=6;
buffer[6]:=116;
buffer[7]:=121;
buffer[8]:=112;
buffer[9]:=101;
curname:=Idlookup(7);
idfirst:=5;
buffer[5]:=117;
buffer[6]:=110;
buffer[7]:=116;
buffer[8]:=105;
buffer[9]:=108;
curname:=Idlookup(21);
idfirst:=7;
buffer[7]:=118;
buffer[8]:=97;
buffer[9]:=114;
curname:=Idlookup(22);
idfirst:=5;
buffer[5]:=119;
buffer[6]:=104;
buffer[7]:=105;
buffer[8]:=108;
buffer[9]:=101;
curname:=Idlookup(12);
idfirst:=6;
buffer[6]:=119;
buffer[7]:=105;
buffer[8]:=116;
buffer[9]:=104;
curname:=Idlookup(12);
idfirst:=3;
buffer[3]:=120;
buffer[4]:=99;
buffer[5]:=108;
buffer[6]:=97;
buffer[7]:=117;
buffer[8]:=115;
buffer[9]:=101;
curname:=Idlookup(23);;
Phasei;
Phaseii;
{224}
BEGIN
Writeln(termout);
Write(termout,'Writing the index...');
END;
Finishline;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=120;
END;
Finishline;
{226}
FOR c:=0 TO 127 DO bucket[c]:=0;
FOR h:=0 TO hashsize-1 DO
BEGIN
nextname:=hash[h];
WHILE nextname<>0 DO
BEGIN
curname:=nextname;
nextname:=link[curname];
IF xref[curname]<>0 THEN
BEGIN
c:=bytemem[curname MOD 2,bytestart[
curname]];
IF(c<=90)AND(c>=65)THEN
c:=c+32;
blink[curname]:=bucket[c];
bucket[c]:=curname;
END;
END;
END;
{233}scrapptr:=0;
Unbucket(1);
WHILE scrapptr>0 DO
BEGIN
curdepth:=cat[scrapptr];
IF(blink[trans[scrapptr]]=0)OR(curdepth=255)THEN
{235}
BEGIN
curname:=
trans[scrapptr];
{IF TROUBLESHOOT THEN DEBUGHELP;}
REPEAT
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=43;
END;
{236}
CASE ilk[curname]OF
0:IF bytestart[curname+2]-bytestart[curname]=1
THEN
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=124;
END
ELSE
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
END;
1:;
2:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=57;
END;
3:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
OTHERS:BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=38;
END
END;
Outname(curname);
{237}{239}thisxref:=xref[curname];
curxref:=0;
REPEAT
nextxref:=xmem[thisxref].xlinkfield;
xmem[thisxref].xlinkfield:=curxref;
curxref:=thisxref;
thisxref:=nextxref;
UNTIL thisxref=0;
REPEAT
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=44;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=32;
END;
curval:=xmem[curxref].numfield;
IF curval<10240 THEN
Outval(curval)
ELSE
BEGIN
BEGIN
IF outptr=linelength
THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=91;
END;
Outval(curval-10240);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=93;
END;
END;
curxref:=xmem[curxref].xlinkfield;
UNTIL curxref=0;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=46;
END;
Finishline;
curname:=blink[curname];
UNTIL curname=0;
scrapptr:=scrapptr-1;
END
ELSE
{234}
BEGIN
nextname:=trans[scrapptr];
REPEAT
curname:=nextname;
nextname:=blink[curname];
curbyte:=bytestart[curname]+curdepth;
curbank:=curname MOD 2;
IF curbyte=bytestart[curname+2]THEN
c:=0
ELSE
BEGIN
c:=bytemem[curbank,
curbyte];
IF(c<=90)AND(c>=65)THEN
c:=c+32;
END;
blink[curname]:=bucket[c];
bucket[c]:=curname;
UNTIL nextname=0;
scrapptr:=scrapptr-1;
Unbucket(curdepth+1);
END;
END;
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=102;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=105;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
Finishline;
{241}Modprint(ilk[0]);
BEGIN
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=92;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=99;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=111;
IF outptr=linelength THEN
Breakout;
outptr:=outptr+1;
outbuf[outptr]:=110;
END;
Finishline;
Write(termout,'Done.');;
{77}
IF changelimit<>0 THEN
BEGIN
FOR loc:=0 TO changelimit DO buffer[loc
]:=changebuffer[loc];
limit:=changelimit;
changing:=true;
line:=otherline;
BEGIN
IF NOT phaseone THEN
BEGIN
Writeln(termout);
Write(termout,'! Change file entry did not match');
Error;
END;
END;
END;
9999:{[246]BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'Memory usage statistics: ',NAMEPTR:0,' names, ',XREFPTR:0
,' cross references, ',BYTEPTR[0]:0);
END;
FOR CURBANK:=1 TO 1 DO WRITE(TERMOUT,'+',BYTEPTR[CURBANK]:0);
WRITE(TERMOUT,' bytes;');
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'parsing required ',MAXSCRPTR:0,' scraps, ',MAXTXTPTR:0,
' texts, ',MAXTOKPTR:0,' tokens, ',MAXSTACKPTR:0,' levels;');
END;
BEGIN WRITELN(TERMOUT);
WRITE(TERMOUT,'sorting required ',MAXSORTPTR:0,' levels.');
END;}
END.